unit uExportDecl_components_functions;

interface
     uses  SysUtils, Classes, Forms, Windows, Graphics, Controls, StdCtrls,
     ExtCtrls, ComCtrls, spin, Dialogs, Menus ;


type

  anchors_t  = packed record
    akLeft   :BOOL;
    akTop    :BOOL;
    akRight  :BOOL;
    akBottom :BOOL;
  end;

  panchors_t = ^anchors_t;


procedure SetControlVisible( pControl :pointer; visible :boolean ); stdcall;
function GetControlVisible( pControl :pointer ) : boolean; stdcall;

function GetControlEnabled(pControl :pointer) : boolean; stdcall;
procedure SetControlEnabled(pCOntrol :pointer; value :boolean); stdcall;

procedure SetComponentTag(pComponent :Pointer; tag :integer); stdcall;
function GetComponentTag(pComponent :pointer) :integer; stdcall;

function GetWinControlHandle(pWinControl :pointer) :HWND; stdcall;

procedure SetComponentCaption(pComponent :pointer;  caption : PAnsiChar); stdcall;
function  GetComponentCaption(pComponent :pointer) :PAnsiChar; stdcall;

procedure SetControlHint(pControl :pointer; const hint :PAnsiChar); stdcall;

procedure GetComponentClassNameCstr(pCOmponent :pointer;
    dest: PAnsiChar; destlen : integer); stdcall;

function GetWinControlClientRect(pComponent :pointer) :TRECT; stdcall;


function GetControlAnchors( pControl :pointer ) :anchors_t; stdcall;

procedure SetControlAnchors( pControl :pointer; const a :panchors_t ); stdcall;

procedure SetControlPopupMenu(pControl:pointer; pPopupMenu :pointer); stdcall;



procedure SetProgressBarPosition(pProgressBar :pointer; posit :integer); stdcall;
function GetProgressBarPosition(pProgressBar :pointer) :integer; stdcall;


procedure SetControlAlign(pControl :Pointer; alg :TAlign); stdcall;
function GetControlAlign(pControl :Pointer) :TAlign; stdcall;

procedure SetControlColor(pCOntrol :Pointer; color: DWORD); stdcall;

procedure SetTreeViewItemData(pTreeNode :pointer; data :pointer); stdcall;
function GetTreeViewItemData(pTreeNode :pointer) :Pointer; stdcall;

procedure SetTreeViewItemImageIndex(pTreeViewItem: Pointer; newIndex :Integer ); stdcall;
function  GetTreeViewItemImageIndex(pTreeViewItem: Pointer) :Integer; stdcall;

procedure SetTreeViewItemText(pTreeViewItem :Pointer; const text :PAnsichar);
procedure GetTreeViewItemText(pTreeViewItem :Pointer; dest :PAnsiChar; destsize :Integer);



//------------------------------------------------------------------------------
implementation //---------------------------------------------------------------
//------------------------------------------------------------------------------





procedure SetControlVisible( pControl :pointer; visible :boolean ); stdcall;
  var c : TControl;
begin
  c := TControl(pControl);
  c.Visible := visible;
end;

function GetControlVisible( pControl :pointer ) : boolean; stdcall;
  var c : TControl;
begin
  c := TControl(pControl);
  result := c.Visible;
end;

function GetControlEnabled(pControl :pointer) : boolean; stdcall;
  var c : TControl;
begin
  c := TControl(pControl);
  result := c.Enabled;

end;

procedure SetControlEnabled(pCOntrol :pointer; value :boolean); stdcall;
     var c : TControl;
begin
  c := TControl(pControl);
  c.Enabled := value;

end;


procedure SetComponentTag(pComponent :Pointer; tag :integer); stdcall;
 var c :TComponent;
begin
 c := TComponent(pComponent);
 c.Tag := tag;
end;

function GetComponentTag( pComponent :pointer ) :integer; stdcall;
 var c :TComponent;
begin
 c := TComponent(pComponent);
 Result := c.Tag;
end;

function GetWinControlHandle(pWinControl :pointer) :HWND; stdcall;
 var wc :TWinControl;
begin
  wc := TWinControl( pWinControl );
  Result := wc.Handle;
end;

procedure SetComponentCaption(pComponent :pointer; caption :PAnsiChar); stdcall;
  var cn :TComponent;

  btn :TButton;
  lbl : TLabel;
  frm : TForm;
  stp : TStatusPanel;

  pIntDoExt : PInteger;
begin
  cn := TComponent(pComponent);

  if cn.ClassName = 'TButton'
  then
    begin
      btn := TButton(pComponent);
      btn.Caption := caption;
      Exit;
    end;

  if cn.ClassName = 'TLabel'
  then
    begin
      lbl := TLabel(pComponent);
      lbl.Caption := caption;
      Exit;
    end;

  if cn.ClassName = 'TForm'
  then
    begin
       frm := TForm( pComponent );
       frm.Caption := caption;
       Exit;
    end;


  if cn.ClassName = 'TStatusPanel'
   then
      begin
        stp := TStatusPanel(pComponent);
        stp.Text := caption;
        Exit;
      end;


    
    // throw
    pIntDoExt := nil;
    pIntDoExt^ := 0;

end;

function  GetComponentCaption(pComponent :pointer) :PAnsiChar; stdcall;
  var cn :TComponent;

  btn :TButton;
  lbl : TLabel;
  frm : TForm;
  stp :TStatusPanel;

  pIntDoExt : PInteger;
begin
  result := nil;
 cn := TComponent(pComponent);

  if cn.ClassName = 'TButton'
  then
    begin
      btn := TButton(pComponent);
      result := PAnsiChar( btn.Caption );
      Exit;
    end;

  if cn.ClassName = 'TLabel'
  then
    begin
      lbl := TLabel(pComponent);
      result := PAnsiChar( lbl.Caption );
      Exit;
    end;

  if cn.ClassName = 'TForm'
  then
    begin
       frm := TForm( pComponent );
       result := PAnsiChar( frm.Caption );
       Exit;
    end;

  if cn.ClassName = 'TStatusPanel'
   then
      begin
        stp := TStatusPanel(pComponent);
        Result := PAnsiChar( stp.Text );
        Exit;
      end;








    // throw
    pIntDoExt := nil;
    pIntDoExt^ := 0;
end;

procedure SetControlHint(pControl :pointer; const hint :PANsiChar); stdcall;
  var c :TControl;
begin
  c := TControl( pControl );
  c.Hint :=  hint;
  c.ShowHint := True;

end;


procedure GetComponentClassNameCstr(pCOmponent :pointer; dest: PAnsiChar; destlen : integer); stdcall;
  var c : TComponent;
  ac : AnsiString;
begin
  c := TComponent( pCOmponent );
  ac := c.classname;
  //result := PAnsiChar( c.ClassName );
  SysUtils.StrLCopy(dest,  PAnsiChar( ac ), destlen );

end;


function GetWinControlClientRect(pComponent :pointer) :TRECT; stdcall;
  var wc :TWinControl;
  var r : TRect;
begin
  wc := TWinControl( pComponent );
  r := wc.ClientRect;
  result := r;
end;

function GetControlAnchors( pControl :pointer ) :anchors_t; stdcall;
  var c :TControl;
  an :TAnchors;
begin
  Result.akLeft := FALSE;
  Result.akTop  := FALSE;
  Result.akRight  := FALSE;
  Result.akBottom := FALSE;

  c := TControl (pControl);
  an := c.Anchors;
  // type TAnchors = set of TAnchorKind;
  // type TAnchorKind = (akTop, akLeft, akRight, akBottom);

  if akTop     in an then  Result.akTop    := TRUE;
  if akLeft    in an then  Result.akLeft   := TRUE;
  if akRight   in an then  Result.akRight  := TRUE;
  if akBottom  in an then  Result.akBottom := TRUE;


end;

procedure SetControlAnchors( pControl :pointer; const a :panchors_t ); stdcall;
  var c :TControl;
  an, add_an :TAnchors;


  pint : PInteger;
begin
   c := TControl(pControl);
   an := [];

    // type TAnchors = set of TAnchorKind;
    // type TAnchorKind = (akTop, akLeft, akRight, akBottom);

   //an := [akTop, akLeft, akRight, akBottom];
   // an := [];
   // add_an := [akTop];
    //an := an + add_an;


    if a^.akLeft then
     begin
       add_an := [akLeft];
       an := an + add_an;
     end;

    if a^.akTop then
     begin
       add_an := [akTop];
       an := an + add_an;
     end;

    if a^.akRight then
     begin
       add_an := [akRight];
       an := an + add_an;
     end;

    if a^.akBottom then
     begin
       add_an := [akBottom];
       an := an + add_an;
     end;

     ShowMessage(' need a check code!');
     c.Anchors := an;


  //pint := nil;
  //pint^ := 0;

end;

procedure SetControlPopupMenu(pControl:pointer; pPopupMenu :pointer); stdcall;
 var
  cn :TComponent;
  pm :TPopupMenu;


  frm :TForm;
  btn :TButton;



begin
 cn := TComponent(pControl);
 pm := TPopupMenu(pPopupMenu);

 if(cn is TButton) then
   begin
    btn := TButton( cn );
    btn.PopupMenu := pm;
    Exit;
   end;

  if(cn is TForm) then
   begin
    frm := TForm( cn );
    frm.PopupMenu := pm;
//    pm.AutoPopup := True;
    Exit;
   end;


 //
 ShowMessage('no code assign popup menu for this control');

end;


procedure SetProgressBarPosition(pProgressBar :pointer; posit :integer); stdcall;
  var b :TProgressBar;
begin
  b := TProgressBar(pProgressBar);
  b.Position := posit;

end;

function GetProgressBarPosition(pProgressBar :pointer) :integer; stdcall;
  var b :TProgressBar;
begin
  b := TProgressBar(pProgressBar);
  Result := b.Position ;

end;

procedure SetControlAlign(pControl :Pointer; alg :TAlign); stdcall;
 var c :TControl;
begin
  c := TControl(pControl);
  c.Align := alg;

end;


function GetControlAlign(pControl :Pointer) :TAlign; stdcall;
 var c :TControl;
begin
  c := TControl(pControl);
  Result := c.Align;
end;


procedure SetControlColor(pCOntrol :Pointer; color: DWORD); stdcall;
  var col : TColor;
   cnt :TComponent;

   frm :TForm;
   lbl :TLabel;
begin
  col := TColor( color );
  cnt := TComponent(pCOntrol);

  if cnt is TForm then
  begin
    frm := TForm( cnt );
    frm.Color := col;
    Exit;
  end;

   if cnt is TLabel then
  begin
    lbl := TLabel( cnt );
    lbl.Color := col;
    Exit;
  end;


 

  raise Exception.Create('unknown component');
end;



procedure SetTreeViewItemData(pTreeNode :pointer; data :pointer); stdcall;
  var n :TTreeNode;
begin
  n := TTreeNode(pTreeNode);
  n.Data := data;

end;

function GetTreeViewItemData(pTreeNode :pointer) :Pointer; stdcall;
  var n :TTreeNode;
begin
    n := TTreeNode(pTreeNode);
    Result := nil;
    result := n.Data;
end;

procedure SetTreeViewItemImageIndex(pTreeViewItem: Pointer; newIndex :Integer ); stdcall;
  var n :TTreeNode;
begin
  n := TTreeNode(pTreeViewItem);
  n.ImageIndex := newIndex;
end;

function  GetTreeViewItemImageIndex(pTreeViewItem: Pointer) :Integer; stdcall;
  var n :TTreeNode;
begin
  result := 0;
  n := TTreeNode(pTreeViewItem);
  result := n.ImageIndex;

end;

procedure SetTreeVIewItemText(pTreeViewItem :Pointer; const text :PAnsichar);
  var n :TTreeNode;
begin
  n := TTreeNode(pTreeViewItem);
  n.Text := text;
end;

procedure GetTreeViewItemText(pTreeViewItem :Pointer; dest :PAnsiChar; destsize :Integer);
  var n :TTreeNode;
begin
   n := TTreeNode(pTreeViewItem);
   SysUtils.StrLCopy(dest, PAnsiChar(n.Text), destsize );

end;






end.
 